Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE07/YAST/VALIDPTR.PAS

Pascal/Delphi Source File | 1996-01-04 | 5.5 KB | 166 lines

Unit ValidPtr;

{ Purpose      : Routine to check the validity of a pointer
  Written by   : Hallvard Vassbotn, Oslo, Norway
  E-Mail       : [e-mail]
  Created      : September 1, 1994
  Requirements : Borland Pascal 7.0 or later

  Information to create this unit was found in:
    - Extending DOS Second Edition by Ray Duncan (Addison Wesley, ISBN 0-201-56798-9)
    - Windows Internals by Matt Pietrek          (Addison Wesley, ISBN 0-201-62217-3)
    - Turbo Assembler Quick Reference Guide      (Borland)
    - The Pascal Magazine, issue 5 (page 38-40)

  Changes:

  04.01.96 : Implemented Julian M. Bucknall's proposed changes
  04.01.96 : Added ValidCodePointer

}

interface

function ValidPointer(P : Pointer; Size: word): boolean;
{ -- Returns true if the pointer P is valid and at least Size bytes are
     accessible through it }

function ValidCodePointer(P : Pointer; Size: word): boolean;
{ -- Returns true if the pointer P is valid and at least Size bytes are
     accessible through it }

implementation

{$IFDEF MSDOS}

{ This is the real mode version included for compatability }

function ValidPointer(P : Pointer; Size: word): boolean;
{ Returns true if the pointer P is not nil. }
begin
  ValidPointer := (P <> nil);
end;

function ValidCodePointer(P : Pointer; Size: word): boolean;
{ Returns true if the pointer P is not nil. }
begin
  ValidCodePointer := (P <> nil);
end;

{$ELSE}

type
  { Type used to typecast a pointer to get the segment and offset parts }
  PtrRec = record
    OffsetW  : word;
    SegmentW : word;
  end;

function ValidPtrSize(P : Pointer; Size: Word): boolean; assembler;
{ Returns true if it is valid to access at least Size bytes through
  the pointer P }
asm
  XOR  AX, AX                 { Set AX to zero     }
  LSL  AX, PtrRec(P).SegmentW { Get limit from LDT, AX=0 if P is not valid }
  MOV  DX, Size               { Get required size... }
  MOV  BX, PtrRec(P).OffsetW  { ...add the offset of the pointer ... }
  ADD  DX, BX                 { ...and store sum in DX }
  CMP  AX, DX                 { Compare with Segment limit }
  MOV  AL, 00
  JB   @ReturnFalse
  INC  AX
@ReturnFalse:
end;

function GetSegmentFlags(P : Pointer): word; assembler;
{ Returns the access flags for the pointer P }
asm
  XOR  AX, AX                 { Set AX to zero     }
  LAR  AX, PtrRec(P).SegmentW { Get flags from LDT, AX=0 if P is not valid }
end;

const
  { These are constants that can be used to get the value of bit-flags
    in the Flags part of an segment descriptor. These flags can be
    accessed by using the LAR assembly instruction }
  dfPresent          = $8000; { The segment is present in memory          }
  dfDPLMask          = $6000; { Mask for Descriptor Privilege Level-field }
  dfSegment          = $1000; { The descriptor is for a segment           }
  dfTypeMask         = $0F00; { Mask to get the Type-field                }
  dfTypeCode         = $0800; { Set for code-segments, otherwise data     }
  dfTypeCodeConform  = $0400; { Conforming code segment                   }
  dfTypeCodeRead     = $0200; { Code-segment can be read for data         }
  dfTypeDataStack    = $0400; { The data segment is a stack (expand-down) }
  dfTypeDataWritable = $0200; { The data segment is writable              }
  dfTypeAccessed     = $0100; { Has the segment ever been accessed ?      }

function Is(Flags, Mask: word): boolean;
begin
  Is := ((Flags and Mask) > 0);
end;

function ForcePresentFlag(P: pointer): word;
{ Returns the access flags for the pointer P.
  If the segment is marked as not-present, try to force it present by
  reading the first byte in the segment. Forcing it present ensures
  that the descriptor contains valid information about size etc.

  Thanks to Julian M. Bucknall for his correction (see Pascal Magazine,
  issue 5, page 38-40). }
var
  Flags : word;
begin
  Flags := GetSegmentFlags(P);
  if     Is(Flags, dfSegment) and
     not Is(Flags, dfPresent) and
    (not Is(Flags, dfTypeCode) or
         Is(Flags, dfTypeCodeRead)) then
  begin
    if byte(P^) = 0 then ;
    Flags := GetSegmentFlags(P);
  end;
  ForcePresentFlag := Flags;
end;

function ValidDataSegment(P : Pointer): boolean;
{ Returns true if P points to a valid data segment }
var
  Flags : word;
begin
  Flags := ForcePresentFlag(P);
  ValidDataSegment :=     Is(Flags, dfSegment)  and
                          Is(Flags, dfPresent)  and
                      not Is(Flags, dfTypeCode) and
                          Is(Flags, dfTypeDataWritable);
end;

function ValidCodeSegment(P : Pointer): boolean;
{ Returns true if P points to a valid data segment }
var
  Flags : word;
begin
  Flags := ForcePresentFlag(P);
  ValidCodeSegment :=     Is(Flags, dfSegment)  and
                          Is(Flags, dfPresent)  and
                          Is(Flags, dfTypeCode) and
                          Is(Flags, dfTypeCodeRead);
end;

function ValidPointer(P : Pointer; Size: word): boolean;
{ Returns true if the pointer P is a valid data segment and
  that at least Size bytes can be accessed without a GPF }
begin
  ValidPointer := ValidDataSegment(P) and ValidPtrSize(P, Size-1);
end;

function ValidCodePointer(P : Pointer; Size: word): boolean;
{ Returns true if the pointer P is a valid data segment and
  that at least Size bytes can be accessed without a GPF }
begin
  ValidCodePointer := ValidCodeSegment(P) and ValidPtrSize(P, Size-1);
end;

{$ENDIF}

end.